perm filename PASS2.MAX[PUB,TES]1 blob
sn#130587 filedate 1974-11-08 generic text, type T, neo UTF8
00100 BEGIN "PUB2"
00200 COMMENT NOTE THAT THE PARCVER USES MEMORY PAGES 700-712 AS A BUFFER ;
00300 REQUIRE "[]<>" DELIMITERS ;
00400 REQUIRE "SITE" SOURCE!FILE;
00500 REQUIRE 6500 STRING!SPACE ;
00600 DEFINE
00700 PASSONE = [FALSE],
00800 PASSTWO = [TRUE],
00900 BEGOF(NAME) = [ ],
01000 ENDOF(NAME) = [ ],
01100 PROCEDURES = [ ],
01200 FINISHED = [ ],
01300 PUBLIC = [ ],
01400 PRIVATE = [ ],
01500 $ = ["],
01600 # = [],
01700 IFK = [IFC],
01800 THENK = [THENC],
01900 IFSITE = [IFK],
02000 SITE(DUMMY) = [ ],
02100 TERNAL = [] ;
02200 REQUIRE "COMMON" SOURCE!FILE ;
02300 COMMENT The Document Compiler -- Pass Two ;
02400 COMMENT Pass One and Two share certain declarations, but in
02500 one case, the meaning of a variable is different:
02600 In Pass 1, XCRIBL is true for either
02700 an XGP -or- PARC's MIC.
02800 In Pass 2, XCRIBL is only true for an
02900 XGP. MICRO is true for PARC's MIC
03000 and RASTER is true for both. ;
03100 COMMENT PASS 1 OUTPUT FORMAT FOR EACH PAGE :
03200 Height Width MillLeftMargin MillRightMargin
03300 For each area:
03400 UpperLine NumCols NumLines
03500 For each column:
03600 LeftChar
03700 For each non-null line:
03705 Line Number
03710 How far short of justification
03715 Excess mill leading
03720 Index of Intermediate Ascii File line
03800 0
03900 -10
04000
04100 PASS 2 reads the output file name and the intermediate page file names from
04200 PUPSEQ.PUI, and the label table from PULABL.PUI. Then it reads
04300 each page from each page file, processes each line in each of
04400 its areas, and writes out a line printer image on the output file.
04500
04600 Each line is subject to three operations, in this order:
04700 (1) Substitute label values at each vertical tab.
04800 (2) Justify the line, if required, by inserting spaces at word breaks marked by altmodes.
04900 (3) Generate underlining and super/sub-scripting as indicated by rubouts.
05000
05100 ;
05200
05300 IFC CMUVER THENC REQUIRE "PUBTMP.SAI" SOURCE!FILE;
05400 ENDC COMMENT RKJ: 26-SEP-74;
05500
05600 DEFINE THRU = [STEP 1 UNTIL], DOWN = [STEP -1 UNTIL],
05700 LH(X) = [(X LSH -18)], RH(X) = [(X LAND '777777)],
05800 AWHILE = [WHILE TRUE],
05900 INNUM = [WORDIN(ICHAN)],
06000 SCN(BRKTBL)= [(IF FROMFILE THEN INPUT(SCHAN,BRKTBL) ELSE SCAN(OWL,BRKTBL,PAGEBRC))],
06100 SCNUM = [CVD(SCN(TO!ALTMODE!SKIP))],
06200 LPT = [1], TTY = [2], MIC = [3], XGP = [4],
06300 HORIZ= ['40], VERTI= ['41], CSIZE= ['42], ULINE= ['43], RSPCS= ['44],
06400 LSPCS= ['45], UDOTS= ['46], RDOTS= ['47], comment FR80 escape codes ;
06500 FULSTR(X) = [LENGTH(X)], NULSTR(X) = [(LENGTH(X)=0)],
06600 CR = ['15], LF = ['12], VT = ['13], FF = ['14], SP = ['40],
06700 RUBOUT = ['177], TB = ['11],
06800 ALTMODE = IFC TENEX THENC ['33] ELSEC
06900 IFC SAILVER THENC ['175] ELSEC ['176] ENDC
07000 ENDC,
07100 TO!ALTMODE!SKIP = [1], TO!LF!APPD = [2],
07200 ONE!CHAR = [3], BREAKER = [4], TO!RUB!ALT!SKIP = [5],
07300 LOCAL!TABLE = [6],
07400 FIML = [256],
07500 ANS(A) = [(S = "A" OR S = "A" + '40)];
07600 DEFINE COMMENT FOR XGP;
07700 USEA= [('177&'14)], USEB= [('177&'15)], VSB= [('177&'20)],
07800 XTAB= [('177&'30)],
07900 XGPNUM(N)= [((N LSH -7) & N)];
08000 DEFINE ESCAPE1= [('177&'1)], ESCAPE2= [('177&'2)];
08100 DEFINE CTLK = [11], CTLF= [6], CTLE= [5], CTLT= ['24], CTLQ= ['21];
08200
08300 IFC SAILVER THENC DEFINE RPGEXT = [".RPG"] ; ENDC
08400
08500 PJ 5/28/74 ; DEFINE
08600 PUIEXT = IFC ITSVER THENC [" PUI"] ELSEC [".PUI"] ENDC,
08700 OCTEXT = IFC ITSVER THENC [" OCT"] ELSEC [".OCT"] ENDC,
08800 TXTEXT = IFC ITSVER THENC [" ASC"] ELSEC [".ASC"] ENDC;
08900
09000 TES 1/7/74 ; DEFINE CTLC= [3], CTLH= ['10], CTLR= ['22], CTLU= ['25], CTLS= ['23] ;
09100 EXTERNAL INTEGER !SKIP! ;
09200 INTEGER BRC, EOF ; COMMENT FOR FONTS TES 10/22/74 ;
09300 INTEGER IML, IMC, comment, no. of lines and chars per page image ;
09400 DEBUG, DEVICE, SEQCHAN, SEQBRC, SEQEOF, comment PUPSEQ.PUI info ;
09500 LFTMAR, comment RASTER left margin (for tabs) ;
09600 RGTMAR, comment RASTER right margin ;
09700 INTRA, comment TES 6/11/74 PARC XGP Intra-line spacing (normally 3) ;
09710 MILLVERTI, RASTVERTI, COMMENT TES 11/2/74 "NORMAL" INTERLINE FOR THIS DOC ;
09800 LISTCHAN, comment output file ;
09900 BAR, TES underlining character (or 0 if OFF) 10/22/73;
10000 PAGEHIGH, PAGEWIDE, comment IML and IMC for latest page ;
10100 I, J, K, L, M, N, DUMMY, comment general-purpose ;
10200 LABCHAN, LABBRC, LABEOF, comment PULABL.PUI info ;
10300 NL, comment LABTAB upper bound ; PAGECT, comment counts pages ;
10400 TABLE, comment LABTAB first subscript -- selects Pass 1 NUMBER vs ITBL ;
10500 ICHAN, SCHAN, FROMFILE, PAGEBRC, PAGEEOF, comment PUIn[S].PUI info ;
10600 TOPLINE, NCOLS, NLINES, comment Area info ;
10700 COL, LEFTCH, comment Column info ;
10800 SLIDETOP, comment top of ∞ stacks such as SLIDESG ;
10900 NCSIZE,CCSIZE, NHORIZ,CHORIZ, NVERTI,CVERTI, comment microfilm normal/current settings ;
11000 NEEDCR, comment, assures CR before every LF for Stanford LPT ;
11100 LINENO, MLEAD, SHORTM, SH, BRKS, FSTBRK, CHRS, FSTCHRS, SG, NOTFST, comment, Line info ;
11200 ONE, comment, 1 ;
11300 BOTMAR, TOPMAR, RASTPHIGH, RASTPWIDE, RASTLHIGH, comment raster units ;
11400 LINEY, CURRENTX, CURRENTY, DLBP, DLBP1, FSTFONT,
11500 TERM, TERMX, LINE, UNDERLINE, CHAR, F, G, LAST, LASL, AVAIL ; comment, Justify info ;
11600
11700 INTEGER SCRIPT, comment baseline adjustment ;
11800 THISFONT, comment PARC font number for scripts;
11900 SCRLVL; comment baseline level ;
12000
12100 INTEGER TLFTMAR ; TVR temporary left margin in XGP pts;
12200 BOOLEAN MICRO, RASTER ; TES 8/23/74 RASTER = XCRIBL OR MICRO ;
12300 IFC CMUVER THENC BOOLEAN FIRST!OUTPUT ; ENDC RKJ: 10-SEP-74 ;
12400 BOOLEAN NEEDFONTS ; TES 10/17/74 FOR PARC MIC ;
12450 BOOLEAN NEEDVERTI ; TES 11/4/74 ;
12500
12600 INTEGER FLUSHING, FSIZE; comment kludges for XGP ;
12700 EXTERNAL INTEGER RPGSW ;
12800 STRING TMPFILE, LISTFILE, PAGEFILE, IFILE, SFILE, S, SR,
12900 OWL, SS, T, ENDLINE, RESTARTLINE, ENDPAGE, DELINT, CRLF, JOBNO ;
13000 STRING SPSSTR ; COMMENT A STRING OF 200 SPACES (TES 8/28/74) ;
13100 TES 1/7/74 ; STRING CMDFILE ;
13200 TES 3/20/74 ; STRING IFILENAME ; INTEGER IFICHAN ;
13300
13400 REAL RATIO ;
13500
13600 INTEGER ARRAY CHARTBL[0:127], XFILL,XINF,SLIDESG,RB,LBD[1:5] ;
13700 INTEGER ARRAY FNTSIZE,FNTCHAN[0:35] ;
13800
13900 STRING ARRAY LBF[1:5] ;
14000
14100 PRELOAD!WITH "", " ", " ", " ", " ", " ", " ",
14200 " ", " ", " ", " " ;
14300 THAFE STRING ARRAY SPSARR[0:10] ;
14400
14500 TES ADDED ALL PARC MIC STUFF ABOUT 8/28/74 : ;
14600
14700 IFCR PARCVER THENC
14800 PARCODES
14900 PARCARRAYS
15000 ENDC
00100 SIMPLE PROCEDURE WARN(STRING MESSG) ;
00110 USERERR(0,1,MESSG) ;
00200
00300 INTEGER SIMPLE PROCEDURE READIN(STRING FILENAME; BOOLEAN BINARY ; REFERENCE INTEGER BRC, EOF) ;
00400 BEGIN "READIN"
00500 INTEGER CH, FLAG ;
00600 CH ← GETCHAN ; EOF ← 0 ; OPEN(CH, "DSK", IF BINARY THEN 8 ELSE 0,2,0,150, BRC, EOF) ;
00700 LOOKUP(CH, FILENAME, FLAG) ;
00800 IF FLAG THEN WARN("Pass one said to read this file: " &
00900 FILENAME & " but it does not exist") ;
01000 RETURN(CH) ;
01100 END "READIN" ;
01200
01300 INTEGER SIMPLE PROCEDURE WRITEON(STRING FILENAME) ;
01400 IFC TENEX THENC
01500 OPENFILE(FILENAME, "WC") ;
01600 ELSEC
01700 BEGIN "WRITEON"
01800 INTEGER CH ;
01900 CH ← GETCHAN ; OPEN(CH, "DSK", 0,0,2,0, 0, 0) ;
02000 AWHILE DO RKJ: 23-JUL-74 - CHECK FOR ENTER FAILURE ;
02100 BEGIN
02200 ENTER(CH, FILENAME, DUMMY←0);
02300 IF NOT DUMMY THEN DONE;
02400 OUTSTR("Cannot ENTER """ & FILENAME & """ Write file: ");
02500 FILENAME←INCHWL;
02600 END;
02700 RETURN(CH);
02800 END "WRITEON" ;
02900 ENDC
03000
03100 IFC TENEX THENC
03200 INTEGER SIMPLE PROCEDURE WRITE16(STRING FILENAME) ;
03300 BEGIN "WRITE16"
03400 INTEGER CH ;
03500 CH ← GTJFN(FILENAME, 1) ;
03600 IF CH<0 THEN WARN("Error in GTJFN of Document file " & FILENAME) ;
03700 OPENF(CH, '200000100000) ;
03800 IF !SKIP! THEN
03810 BEGIN
03820 ERSTR(!SKIP!,0) ;
03830 WARN("Error opening Document file " & FILENAME) ;
03840 END ;
03900 RETURN(CH) ;
04000 END "WRITE16" ;
04100 ENDC
04200
04400 STRING SIMPLE PROCEDURE MICROFILM(INTEGER OP, ARG) ;
04500 RETURN('177 & OP & (IF OP LEQ '42 THEN (ARG DIV 128)&(ARG MOD 128) ELSE ARG)) ;
04600 STRING SIMPLE PROCEDURE SETSIZE(INTEGER N) ; RETURN(MICROFILM(CSIZE, CCSIZE ← N)) ;
04700 STRING SIMPLE PROCEDURE SETHORIZ(INTEGER N) ; RETURN(MICROFILM(HORIZ, CHORIZ ← N)) ;
04800 STRING SIMPLE PROCEDURE SETVERTI(INTEGER N) ; RETURN(MICROFILM(VERTI, CVERTI ← N)) ;
04900 STRING SIMPLE PROCEDURE DOULINE(INTEGER N) ; RETURN(MICROFILM(ULINE, N)) ;
05000 STRING SIMPLE PROCEDURE DORSPCS(INTEGER N) ; RETURN(MICROFILM(RSPCS, N)) ;
05100 STRING SIMPLE PROCEDURE DOLSPCS(INTEGER N) ; RETURN(MICROFILM(LSPCS, N)) ;
05200 STRING SIMPLE PROCEDURE DOUDOTS(INTEGER N) ; RETURN(MICROFILM(UDOTS, N)) ;
05300 STRING SIMPLE PROCEDURE DORDOTS(INTEGER N) ; RETURN(MICROFILM(RDOTS, N)) ;
05400
05500 RECURSIVE STRING PROCEDURE VARBLANK(INTEGER N);
05600 BEGIN "VARBLANK"
05700 IFC CMUXGP THENC
05800 IF N LEQ 0 THEN RETURN(NULL) ELSE
05900 IF N GEQ 128 THEN RETURN(VSB & 127 & VARBLANK(N-127)) ELSE
06000 RETURN(VSB&N)
06100 ELSEC IFC SAILXGP THENC
06200 IF N LEQ 0 THEN RETURN(NULL) ELSE
06300 IF N GEQ 64 THEN RETURN(ESCAPE2 & 63 & VARBLANK(N-63)) ELSE
06400 RETURN(ESCAPE2&N)
06500 ELSEC IFC PARCVER THENC
06600 RETURN(CTLE&CVS(N)&".")
06700 ENDC ENDC ENDC;
06800 END "VARBLANK";
06900
07000 INTERNAL STRING SIMPLE PROCEDURE SPS(INTEGER N) ;
07100 IF N LEQ 10 THEN RETURN(SPSARR[N MAX 0])
07200 ELSE IF DEVICE=MIC THEN RETURN(DORSPCS(N))
07300 ELSE RETURN(SPSSTR[1 TO N]) ;
07400
07500 IFC TENEX THENC
07600 STRING PROCEDURE SCANTO(STRING BRKS; REFERENCE STRING SCANNEE; BOOLEAN INCLUDE) ;
07700 BEGIN
07800 INTEGER DUMMY ;
07900 SETBREAK(LOCAL!TABLE, BRKS, NULL, IF INCLUDE THEN "IA" ELSE "IR") ;
08000 RETURN(SCAN(SCANNEE, LOCAL!TABLE, DUMMY)) ;
08100 END ;
08200 ENDC
08300
08400 IFC PARCVER THENC PARCOUT ENDC
08500
08600 STRING SIMPLE PROCEDURE SPARAM ;
08700 BEGIN "SPARAM"
08800 STRING S ;
08900 S ← NULL ;
09000 DO S ← S & INPUT(SEQCHAN, TO!ALTMODE!SKIP) UNTIL SEQBRC = ALTMODE OR SEQEOF ;
09100 RETURN(S) ;
09200 END "SPARAM" ;
09300
09400 INTEGER SIMPLE PROCEDURE IPARAM ; RETURN(CVD(SPARAM)) ;
09500
09600 IFC CMUXGP THENC RKJ: 29-AUG-74;
09700
09800 INTEGER SIMPLE PROCEDURE INDEX2(STRING A,B);
09900 comment returns the location of the first occurance of
10000 the string B in A, 0 if none;
10100 BEGIN "INDEX2"
10200 INTEGER LA, LB;
10300 IF (LB←LENGTH(B))=0 THEN RETURN(1);
10400 IF (LA←LENGTH(A)-LB+1) LEQ 0 THEN RETURN(0);
10500 START!CODE
10600 LABEL L1, L2, OUTT, NEXT;
10700 MOVE 2,A; MOVN 1,LA; ILDB 0,B; SOS 0,LB;
10800 L1: ILDB 3,2; CAME 3,0; NEXT: AOJL 1,L1;
10900 JUMPE 1,OUTT;
11000 MOVE 4,2; MOVE 5,B; MOVE 6,LB;
11100 L2: ILDB 7,4; ILDB '10,5; CAME 7,'10; JRST NEXT; SOJG 6,L2;
11200 ADD 1,LA; AOJ 1,0;
11300 OUTT:
11400 END;
11500 END "INDEX2";
11600
11700 SIMPLE STRING PROCEDURE FIXUP(STRING S);
11800 BEGIN "FIXUP"
11900 INTEGER ALOC,BLOC;
12000 IF NOT XCRIBL THEN RETURN(S) ; RKJ: 28-SEP-74 ;
12100 IF (ALOC←INDEX2(S,USEA))=1 THEN RETURN(S);
12200 IF (BLOC←INDEX2(S,USEB))=1 THEN RETURN(S);
12300 IF ALOC=0 THEN ALOC←BLOC;
12400 IF BLOC=0 THEN BLOC←ALOC;
12500 ALOC←ALOC MIN BLOC;
12600 RETURN(S[ALOC FOR 2]&S[1 TO ALOC-1]&S[ALOC+2 TO ∞]);
12700 END "FIXUP";
12800 ELSEC
12900 DEFINE FIXUP(X)="X";
13000 ENDC
13100
13200 IFC TENEX THENC
13300 SIMPLE PROCEDURE SFBSZ(INTEGER CHAN, SIZE) ;
13400 BEGIN "SFBSZ"
13500 INTEGER K ;
13600 DEFINE JSYS=['104000000000], SFBSZ=[JSYS '46];
13700 K ← CVJFN(CHAN) ;
13800 START!CODE "BYTE16"
13900 MOVE 1,K; MOVE 2,SIZE; SFBSZ ;
14000 END "BYTE16" ;
14100 END "SFBSZ" ;
14200 ENDC
00100 ONE ← 1 ; COMMENT TO FORCE ARRAY TO BE DYNAMIC ;
00200 BEGIN "VARIABLE BOUND ARRAY BLOCK"
00300 THAFE INTEGER ARRAY CW[0:ONE] ;
00400 REQUIRE "DATUM" SOURCE!FILE ;
00500 REQUIRE "FONTS" SOURCE!FILE ;
00600
00700 BOOLEAN SIMPLE PROCEDURE READFONT(INTEGER WHICH) ;
00800 BEGIN
00900 INTEGER CHAN ;
01000 FNTCHAN[WHICH] ← CHAN ←
01100 IFC PARCVER THENC OPENFILE(FNTNAME[WHICH], "RO")
01200 ELSEC READIN(FNTNAME[WHICH], TRUE, BRC, EOF) ENDC ;
01300 IF CHAN<0 THEN WARN("Can not open font file " &
01400 FNTNAME[WHICH] & " in pass two. This is a bug") ; TES 10/18/74 ;
01500 BRC ← FNTFIL[WHICH] ← CREATE(0,127) ; MAKEBE(BRC, CW) ;
01600 FNTSIZE[WHICH] ← PERUSEFONT(WHICH, CHAN) ;
01700 IFC PARCVER THENC RETURN(FNTNUMBER[WHICH]<0) TES 10/17/74 ;
01800 ELSEC RELEASE(CHAN) ENDC ;
01900 END "READFONT" ;
02000
02100 COMMENT I N I T I A L I Z E ;
02200
02300 WCW ← WHATIS(CW) ;
02400
02500 IFC PARCVER THENC
02600 SR ← NULL ;
02700 DUMMY←CVSIX("PUB2 ");
02800 START!CODE
02900 MOVE 1,DUMMY;
03000 '104000000210;
03100 END;
03200
03300 ARRCLR(NILS, 1) ;
03400 ENDC
03500
03600 SPSSTR ← SP ;
03700 FOR I ← 1 THRU 200 DO SPSSTR ← SPSSTR & SP ; TES 8/28/74 ;
03800
03900 SCRIPT ← 10;
04000 IFC TENEX THENC JOBNO ← CVS(GJINF(DUMMY, DUMMY, DUMMY)) ; ENDC TES 10/25/73 ;
04100
04200 IFC PARCVER THENC IML←65; IMC←72; ENDC
04300 IFC SAILVER THENC IML←53; IMC←69; ENDC
04400 IFC ITSVER THENC IML←55; IMC←69; ENDC PJ 5/28/74 ;
04500 IFC CMUVER THENC IML←55; IMC←69; ENDC
04600 IFC ISIVER THENC IML←55; IMC←69; ENDC
04700 PAGEHIGH ← PAGEWIDE ← PAGECT ← 0 ; CRLF ← CR & LF ;
04800 SETBREAK(ONE!CHAR, NULL, NULL, "XA") ;
04900 SETBREAK(TO!ALTMODE!SKIP, ALTMODE, NULL, "IS") ;
05000 SETBREAK(TO!LF!APPD, LF, NULL, "IA") ;
05100 SETBREAK(BREAKER, RUBOUT&VT&ALTMODE&CR&LF, NULL, "IS") ;
05200 SETBREAK(TO!RUB!ALT!SKIP, RUBOUT&ALTMODE, NULL, "IS") ;
05300 IFC TENEX THENC
05400 IF RPGSW THEN
05500 BEGIN
05600 IFICHAN ← READIN(JOBNO & ".PASS2", FALSE, DUMMY, DUMMY) ;
05700 IFILENAME ← INPUT(IFICHAN, TO!ALTMODE!SKIP) ;
05800 RELEASE(IFICHAN) ; TES 6/11/74 ;
05900 END
06000 ELSE BEGIN TES 6/11/74 REVISED ;
06100 OUTSTR("MANUSCRIPT: ") ;
06200 WHILE -1 = (J ←
06300 GTJFNL(NULL, '162000000000, '100000101,
06400 NULL, NULL, NULL, "PUB", NULL, NULL, NULL)) DO
06500 OUTSTR(" ?" & CRLF & "MANUSCRIPT: ") ;
06600 IFILENAME ← JFNS(J, '1000000000) ;
06700 RLJFN(J) ;
06800 END ;
06900 ENDC
07000
07100 OUTSTR("PASS TWO ") ;
07200
07300 SEQCHAN ← READIN(
07400 IFC TENEX THENC IFILENAME&".FILES" ELSEC "PUPSEQ"&PUIEXT ENDC,
07500 FALSE, SEQBRC, SEQEOF) ;
07600
07700 TMPFILE ← SPARAM ;
07800 LISTFILE ← SPARAM ;
07900
08000 DEBUG ← IPARAM ;
08100
08200 DEVICE ← IPARAM ;
08300 XCRIBL ← DEVICE=XGP ;
08400 IFC PARCVER THENC
08500 MICRO ← DEVICE=MIC ;
08600 PDIX ← OUTCOUNT ← 0 ;
08700 IF MICRO THEN
08800 BEGIN
08900 DLBP1 ← '041000677777 ; COMMENT BYTE POINTER ;
09000 END ;
09100 ELSEC MICRO ← FALSE ; ENDC ;
09200 RASTER ← MICRO OR XCRIBL ;
09300
09400 DELINT ← SPARAM ;
09500
09600 LOFONT ← IPARAM ; HIFONT ← IPARAM ;
09700 NEEDFONTS ← FALSE ; TES 10/17/74 ;
09800 FOR J ← LOFONT THRU HIFONT DO
09900 IF FULSTR(FNTNAME[J] ← SPARAM) THEN
10000 IF READFONT(J) THEN NEEDFONTS ← TRUE ;
10100 IFC PARCVER THENC
10200 IF MICRO AND NEEDFONTS THEN
10300 BEGIN TES 10/17/74 ;
10400 K ← -1 ;
10500 FOR J ← LOFONT THRU HIFONT DO IF FULSTR(FNTNAME[J]) THEN
10600 FNTNUMBER[J] ← K ← K + 1 ;
10700 END ;
10800 ENDC
10900
11000 CMDFILE ← SPARAM ;
11100
11200 BAR ← SPARAM[1 FOR 1] ;
11300 IF BAR = SP THEN BAR ← 0 ; TES 10/22/73 ;
11400
11500 CHARW ← IPARAM;
11550 NEEDVERTI ← FALSE ;
11600 IF (MILLVERTI←IPARAM) LEQ 0 THEN
11610 BEGIN
11620 INTRA ← IFC NOT SAILXGP THENC 0 ; ENDC
11630 MILLVERTI ← ABS(MILLVERTI) ;
11635 NEEDVERTI ← RASTER ;
11640 END
11650 ELSE INTRA ← MILLVERTI ;
11700 BASELINE ← IPARAM; BASELINE←BASELINE+(BASELINE DIV 4);
11800 DOPASS3 ← IPARAM; RKJ: 1-4-74;
11900 IFC CMUVER THENC FIRST!OUTPUT ← NOT DOPASS3 ; ENDC RKJ: 28-SEP-74 ;
12000 VBPI ← IPARAM ;
12100 HBPI ← IPARAM ;
12200 MINLFTMAR ← IPARAM ;
12210
12220 INTRA ← (INTRA*VBPI + 500)/1000 ; TES 11/2/74 ;
12230 RASTVERTI ← (MILLVERTI*VBPI + 500)/1000 ; TES 11/2/74 ;
12240
12300
12400 IF NOT RPGSW AND NOT RASTER THEN COMMENT STARTED BY ".R PUB2" ;
12500 DO BEGIN
12600 OUTSTR("OUTPUT DEVICE (LPT or TTY): ") ;
12700 S ← INCHWL ;
12800 DEVICE ← IF ANS(L) THEN LPT ELSE IF ANS(T) THEN TTY ELSE 0 ;
13000 END
13100 UNTIL DEVICE ;
13200 IF NOT RPGSW AND DEBUG THEN
13300 IF DEVICE = MIC THEN DEBUG ← 0
13400 ELSE DO BEGIN
13500 OUTSTR("Debug info in right margin? (Y or N) = ") ;
13600 S ← INCHWL ;
13700 DEBUG ← IF ANS(Y) THEN -1 ELSE IF ANS(N) THEN 0 ELSE 100 ;
13800 END
13900 UNTIL DEBUG < 100 ;
14000
14100 ENDLINE ← LF ; ENDPAGE ← FF ;
14200 IFC PARCVER THENC IF MICRO THEN ENDLINE ← MEOL ; ENDC
14300 RESTARTLINE ←
14400 IFC PARCVER THENC IF XCRIBL THEN CTLT&"0." ELSE CR
14500 ELSEC CR ENDC ; TES 11/1/73 ;
14600
14700 IFC SAILVER THENC
14800 CASE DEVICE-1 OF
14900 BEGIN "DEV"
15000 comment 1...LPT ; LISTCHAN ← WRITEON(LISTFILE) ;
15100 comment 2...TTY ; LISTCHAN ← WRITEON(LISTFILE) ;
15200 comment 3...MIC ; BEGIN IML ← IMC ← 1 ; LISTCHAN ← WRITEON(TMPFILE) ;
15300 IF DEBUG THEN BEGIN OUTSTR(CRLF&"Won't put Debug info on Microfilm"&CRLF) ;
15400 DEBUG ← FALSE ; END END ;
15500 COMMENT 4...XGP ; LISTCHAN ← WRITEON(LISTFILE)
15600 END "DEV" ;
15700 ELSEC
15800 IFC PARCVER THENC
15900 IF MICRO THEN LISTCHAN ← WRITE16(LISTFILE) ELSE
16000 ENDC
16100 LISTCHAN ← WRITEON(LISTFILE) ;
16200 ENDC
16300 IFC TENEX THENC LISTFILE ← JFNS(LISTCHAN, 0) ; ENDC
16400 OUTSTR(LISTFILE) ;
16500
16600 J ← 0 ; FOR K ← RUBOUT, ALTMODE, VT, CR, LF DO CHARTBL[K] ← J ← J + 1 ;
16700
16800 LABCHAN ← READIN(
16900 IFC TENEX THENC IFILENAME&".LABELS" ELSEC "PULABL"&PUIEXT ENDC,
17000 FALSE, LABBRC, LABEOF) ;
17100 NL ← CVD(INPUT(LABCHAN, TO!ALTMODE!SKIP)) ;
17200
17300 LASL ← 1000 ; comment, last physical line occupied on the page ;
17400
17500 S←INPUT(SEQCHAN,TO!LF!APPD); comment get to right place ;
17600
17700 TES 1/7/74 ADDED : TES 6/11/74 WITH INTRA:;
17800 IFC PARCVER THENC
17900 IF XCRIBL THEN OUT(LISTCHAN,
18000 (RUBOUT&CTLC) & CMDFILE &
18100 ("K EFHJKLMQRSTU" & CR & "I " & CVS(INTRA) &
18200 CR & "M 0" & CR & "W 1600" & CR & "E" & CR)) ;
18300 COMMENT
18400 CTLC Initiallize switches (used as RUBOUT CTLC)
18500 CTLE Variable blank
18600 CTLF Font change
18700 CTLH Overstrike
18800 CTLJ=LF Line Feed
18850 CTLK Vertical Spacing
18900 CTLL=FF Form Feed
19000 CTLM=CR Carriage Return
19100 CTLQ Quote control character
19200 CTLR Return to baseline from ript
19300 CTLS Subscript
19400 CTLT Tab
19500 CTLU Superscript
19600 RUBOUT Treat as control character (inverse CTLQ)
19700 ;
19800 ENDC
19900
20000 IFC SAILVER THENC
20100 IF XCRIBL THEN OUT(LISTCHAN, "/LMAR="&CVS(LFTMAR)&CMDFILE&CRLF&FF) ;
20200 ENDC
20300 IFC ITSVER THENC PJ 8/24/74 ;
20400 IF XCRIBL THEN OUT(LISTCHAN,";LFTMAR "&CVS(LFTMAR)&CRLF&
20500 ";VSP "&CVS(INTRA)&CRLF&
20600 ";SKIP 1"&CRLF&
20700 CMDFILE&CRLF&FF);
20800 ENDC
00100 BEGIN "INNER BLOCK"
00200
00300 STRING ARRAY LABTAB[0:1, 0:NL], OWLS[0:FIML-1] ;
00400
00500 AWHILE DO
00600 BEGIN "LABEL"
00700 TABLE ← CVD(INPUT(LABCHAN, TO!ALTMODE!SKIP)) ; IF LABEOF THEN DONE ;
00800 LABTAB[TABLE, CVD(INPUT(LABCHAN, TO!ALTMODE!SKIP))] ←
00900 INPUT(LABCHAN, TO!ALTMODE!SKIP) &
01000 (IF RASTER THEN
01100 (ALTMODE & INPUT(LABCHAN, TO!ALTMODE!SKIP))
01200 ELSE NULL);
01300 END "LABEL" ;
01400
01500 RELEASE(LABCHAN);
01600
01700 COMMENT G O ! ;
01800
01900 IF MICRO THEN IML ← 1 ; COMMENT SAVE STORAGE ;
02000 DO comment, This loop is re-entered only if page image grows ;
02100
02200 BEGIN "SIZE"
02300 THAFE STRING ARRAY IMG[1:IML+IML], SEG[0:8*IMC], SRCREF[1:IML] ;
02400 THAFE INTEGER ARRAY LINK,FAKE,LASC[1:IML+IML], LEADING[1:IML+1] ;
02500 LABEL CONTINUE ;
02600
02700 COMMENT * * * * A P P D * * * * ;
02800
02900 INTEGER SIMPLE PROCEDURE APPD(STRING S) ;
03000 IFC PARCVER THENC PARCAPPD ENDC
03100 BEGIN "APPD"
03200 INTEGER HAD, EXTRA, SPACES, F ; STRING T, SS ;
03300 L ← LINE ; EXTRA ← LENGTH(S) ;
03400 IF XCRIBL THEN
03500 BEGIN TES 11/13/73 FOR MULTI-COLUMNS ;
03600 IF CHAR < (HAD ← LASC[L]) THEN
03700 BEGIN
03800 FAKE[L] ← FAKE[L] + HAD - CHAR ;
03900 HAD ← LASC[L] ← CHAR ;
04000 END
04100 END
04200 ELSE
04300 WHILE CHAR < (HAD ← LASC[L]) DO IF (F←LINK[L]) THEN L ← F ELSE
04400 IF (LINK[L] ← AVAIL←AVAIL+1) > IML+IML THEN
04410 WARN("Too much for one page: " & S)
04500 ELSE L ← AVAIL ;
04600 SPACES ← CHAR - HAD ; HAD ← HAD + FAKE[L] ;
04700 T ← IMG[L] ;
04800 IF LENGTH(T) < HAD+SPACES+EXTRA THEN
04900 BEGIN comment no room -- must use concatenate ;
05000 SS ← SPS(SPACES) ;
05100 IF DEVICE=MIC THEN FAKE[L] ← FAKE[L] + LENGTH(SS) - SPACES ;
05200 IMG[L] ← IF HAD THEN T[1 TO HAD]&SS&S ELSE (0&SS&S)[2 TO ∞]
05300 END
05400 ELSE BEGIN comment there's room in old string -- IDPB into it.;
05500 SS ← T[HAD + 1 FOR 1] ; comment byte pointer to IDPB place ;
05600 START!CODE "APPEND" LABEL LOOP1, LOOP2 ;
05700 MOVE 1, SS ; MOVE 2, S ; MOVE 3, EXTRA ;
05800 MOVE 4, SPACES ; JUMPE 4, LOOP2 ; MOVEI 5, '40 ; LOOP1: IDPB 5,1 ; SOJG 4,LOOP1 ;
05900 LOOP2: ILDB 5, 2 ; IDPB 5, 1 ; SOJG 3, LOOP2 ;
06000 END "APPEND" ;
06100 END ;
06200 RETURN(LASC[L] ← CHAR + EXTRA) ;
06300 END "APPD" ;
06400
06500 COMMENT * * * * C T R L * * * * ;
06600
06700 SIMPLE PROCEDURE CTRL(STRING S) ;
06800 BEGIN "CTRL"
06900 CHAR ← 0 MAX APPD(S) - LENGTH(S) ;
07000 LASC[L] ← CHAR ;
07100 FAKE[L] ← FAKE[L] + LENGTH(S) ;
07200 END "CTRL" ;
07300
07400 SIMPLE PROCEDURE MCTRL(INTEGER C) ;
07500 BEGIN "MCTRL"
07600 QUICK!CODE "MCTRLAPPEND"
07700 LABEL RBYTE ;
07800 DEFINE WD=['13] ;
07900 MOVE WD, C ;
08000 CAIG WD,'377 ;
08100 JRST RBYTE ;
08200 ROT WD, -8 ;
08300 IDPB WD, DLBP ;
08400 ROT WD, 8 ;
08500 RBYTE:
08600 IDPB WD, DLBP ;
08700 END "MCTRLAPPEND" ;
08800 END "MCTRL" ;
00100 SIMPLE PROCEDURE UNDERSCORE(INTEGER RIGHTCHAR) ;
00200 BEGIN "UNDERSCORE"
00300 INTEGER NUMCHARS, DESCEND, SAVEHORIZ ;
00400 NUMCHARS ← RIGHTCHAR - UNDERLINE ;
00500 IF NUMCHARS > 0 THEN
00600 BEGIN
00700 SAVEHORIZ ← CHORIZ ;
00800 DESCEND ← CCSIZE DIV 4 ;
00900 CTRL( DOLSPCS(CHAR-UNDERLINE) & DOUDOTS(-DESCEND) & DOULINE(NUMCHARS-1) &
01000 SETHORIZ(CCSIZE) & DOULINE(1) & DOLSPCS(1) & SETHORIZ(SAVEHORIZ) &
01100 DOUDOTS(DESCEND) & DORSPCS(CHAR - RIGHTCHAR + 1) ) ;
01200 UNDERLINE ← RIGHTCHAR ;
01300 END ;
01400 END "UNDERSCORE" ;
01500
01600 SIMPLE PROCEDURE CHANGESPACING ;
01700 IF (N←CHRS-CHAR-1)>0 AND (K←(J←N*CHORIZ+SHORTM)/N MIN 511) NEQ CHORIZ THEN
01800 BEGIN "CHANGESPACING"
01900 IF UNDERLINE GEQ 0 THEN UNDERSCORE(CHAR) ;
02000 SHORTM ← J - K*N ;
02100 IF NOTFST AND (UNDERLINE<0 OR SHORTM<0) THEN
02200 BEGIN CTRL(DORDOTS(SHORTM)) ; SHORTM ← 0 END ; TES CTRL 8/28/74;
02300 CTRL(SETHORIZ(K)) ; NOTFST ← TRUE ;
02400 END "CHANGESPACING" ;
02500
02600 SIMPLE PROCEDURE FONTSELECT(INTEGER WHICH);
02700 BEGIN "FONTSELECT"
02800 IF (WHICH←WHICH-"0")>9 THEN WHICH←WHICH-("A"-"0"-10);
02900 THISFONT ← WHICH ; TES 10/17/74 ;
03000 IFC CMUXGP THENC
03100 WHICH←WHICH MOD 9; COMMENT MAKE 1,A 2,B EQUIVALENT;
03200 IF WHICH=1 THEN CTRL(USEA) ELSE
03300 IF WHICH=2 THEN CTRL(USEB) ELSE
03400 WARN("Font " & CVS(WHICH) & " ignored")
03500 ELSEC IFC SAILXGP THENC
03600 IF WHICH>16 THEN WARN("Font " & CVS(WHICH) & " ignored") ELSE
03700 BEGIN
03800 CTRL(ESCAPE1&(WHICH-1));
03900 IF SCRLVL THEN CTRL(ESCAPE1&'43&SCRLVL);
04000 END;
04100 ELSEC IFC PARCVER THENC
04200 PARCFONT
04300 ENDC ENDC ENDC;
04400 END "FONTSELECT";
04500
04600 STRING SIMPLE PROCEDURE XTABSTR(INTEGER N); RKJ: NEW 1-4-74;
04700 BEGIN "XTABSTR"
04800 IFC CMUXGP THENC RETURN(XTAB&XGPNUM(N)) ENDC
04900 IFC SAILXGP THENC
05000 RETURN(ESCAPE1&'40&XGPNUM(N))
05100 ENDC
05200 IFC PARCVER THENC
05300 RETURN(CTLT&CVS(N)&".")
05400 ENDC;
05500 END "XTABSTR";
05600
05700 SIMPLE PROCEDURE XGPTAB(INTEGER N); RKJ: NEW 1-4-74;
05800 CTRL(XTABSTR(N+TLFTMAR));
05900
06000 STRING PROCEDURE SCNBYCOUNT(INTEGER COUNT) ;
06100 BEGIN
06200 INTEGER I ; STRING S ;
06300 S ← NULL ;
06400 FOR I ← 1 THRU COUNT DO S ← S & SCN(ONE!CHAR) ;
06500 RETURN(S) ;
06600 END ;
06700
06800 SIMPLE STRING PROCEDURE UNMASH(STRING Q) ;
06900 BEGIN TES 8/14/74 PACK EXCESS-64 4-BIT BYTES INTO 7-BIT BYTES ;
07000 STRING S ; S ← NULL ;
07100 WHILE FULSTR(Q) DO S ← S & (((LOP(Q)-64)LSH 4) + (LOP(Q)-64)) ;
07200 RETURN(S) ;
07300 END ;
07400
07500 SIMPLE INTEGER PROCEDURE BYTECOUNT(INTEGER BPNOW, BPTHEN) ;
07600 RETURN(
07700 ((RH(BPNOW)-RH(BPTHEN)) LSH 2) + ((28-((BPNOW ROT 6) LAND '77)) LSH -3) - 3
07800 ) ;
07900
08000 IFC PARCVER THENC PARCLINE ENDC
08050
08100 SIMPLE PROCEDURE IMPOSSIBLE(STRING HOW) ;
08200 BEGIN "IMPOSSIBLE"
08300 IF SG > -1 THEN
08400 BEGIN
08500 OUTSTR(CRLF & HOW & " Error."&CRLF&
08600 "This is an encoding of text line " & CVS(LINE) & ":" & CRLF) ;
08700 FOR I ← 1 THRU SG DO OUTSTR(SEG[I]) ;
08800 END ;
08900 WARN("A supposedly impossible condition has been encountered."&CRLF&
09000 "This is most likely a PUB bug. However, you may have an error"&CRLF&
09100 "which produced unanticipated line lengths or other strange effects."&
09150 (IF DEBUG THEN CRLF&"Line/Page: "&SRCREF[LINE] ELSE NULL)) ;
09200 END "IMPOSSIBLE" ;
00010 SIMPLE PROCEDURE SLIDERROR ;
00020 BEGIN
00030 IMPOSSIBLE(CVS(SLIDETOP)&" Horizontal Positioning") ;
00040 SLIDETOP ← 1 ;
00050 END ;
00060
00100 SIMPLE PROCEDURE RIGHTBOUND ;
00200 BEGIN "RIGHTBOUND" COMMENT RIGHT BOUND OF ∞ ;
00300 INTEGER DEST, FILLIN, I ; STRING FILLER, OLBF ;
00400 INTEGER XF; STRING XTO ; TES 3/30/74;
00500 IF SLIDETOP < 1 THEN SLIDERROR ;
00600 IF LBD[SLIDETOP] < -900 THEN COMMENT FLUSH RIGHT ;
00700 BEGIN
00800 IF RASTER THEN
00900 BEGIN
01000 XF←RB[SLIDETOP]-(XFILL[SLIDETOP]+FSIZE);
01100 XTO ← "=" ;
01200 END ;
01300 FILLIN←RB[SLIDETOP]-CHRS;
01400 END
01500 ELSE COMMENT CENTER ;
01600 BEGIN
01700 IF RASTER THEN
01800 BEGIN
01900 XF ← (RB[SLIDETOP]-LBD[SLIDETOP]-(XFILL[SLIDETOP]+FSIZE)) DIV 2;
02000 XTO ← "+" ;
02100 END ;
02200 FILLIN ← ((RB[SLIDETOP]-CHRS) DIV 2) MAX 0;
02300 END;
02400 DEST ← CHRS + FILLIN ; OLBF ← LBF[SLIDETOP] ;
02500 IF FULSTR(OLBF) THEN
02600 IF RASTER THEN
02700 BEGIN "XGPINFINITY"
02800 FILLER ← NULL ;
02900 FOR I ← 1 THRU XINF[SLIDETOP] DO FILLER ← FILLER & OLBF ;
03000 SEG[I ← SLIDESG[SLIDETOP]] ← FILLER ;
03100 SEG[I + 1] ← RUBOUT & XTO & CVS(XF) ;
03200 END "XGPINFINITY"
03300 ELSE
03400 BEGIN "NON-BLANKS"
03500 FILLER ← NULL ;
03600 WHILE CHRS < DEST DO
03700 BEGIN
03800 FILLER ← FILLER & OLBF ;
03900 CHRS ← CHRS + LENGTH(OLBF) ;
04000 END ;
04100 IF CHRS > DEST THEN FILLER ← FILLER[1 TO ∞-(CHRS-DEST)] ;
04200 SEG[SLIDESG[SLIDETOP]] ← FILLER ;
04300 END "NON-BLANKS"
04400 ELSE SEG[SLIDESG[SLIDETOP]] ← RUBOUT &
04500 (IF RASTER THEN (XTO&CVS(XF))
04600 ELSE ("+"&CVS(FILLIN)) );
04700 CHRS ← DEST ; SLIDETOP ← SLIDETOP - 1 ;
04800 BRKS ← 0 ; FSTCHRS ← CHRS ; FSTBRK ← SG ; COMMENT NOJUST TO LEFT ;
04900 FLUSHING ← FALSE ; FSIZE ← 0 ;
05000 END "RIGHTBOUND";
05100
05200 SIMPLE INTEGER PROCEDURE STEP!SG ;
05300 IF SG<8*IMC THEN RETURN(SG←SG+1)
05400 ELSE BEGIN
05450 IMPOSSIBLE("Line complexity") ;
05800 RETURN(SG←0) ;
05900 END ;
00100 IF PAGEHIGH THEN GO TO CONTINUE ; comment, re-entered ;
00200 AWHILE DO
00300 BEGIN "FILE"
00400 PAGEFILE ← SPARAM ; IF SEQEOF THEN DONE ;
00500 IFC TENEX THENC
00600 IFILE ← IFILENAME & OCTEXT & PAGEFILE ;
00700 SFILE ← IFILENAME & TXTEXT & PAGEFILE ;
00800 ELSEC
00900 IFILE ← PAGEFILE & PUIEXT ; SFILE ← PAGEFILE & "S"&PUIEXT ;
01000 ENDC
01100 ICHAN ← READIN(IFILE, TRUE, PAGEBRC, PAGEEOF) ; SCHAN ← READIN(SFILE, FALSE, PAGEBRC, PAGEEOF) ;
01200
01300 AWHILE DO
01400 BEGIN "PAGE"
01500 PAGEHIGH ← INNUM ; IF PAGEEOF OR PAGEHIGH LEQ 0 THEN DONE ; PAGEWIDE ← INNUM ;
01600 LFTMAR ← 0 MAX (INNUM*HBPI + 500)/1000 - MINLFTMAR ; TES 6/11/74 ADDED ;
01700 RGTMAR ← 0 MAX ((8500-INNUM)*HBPI + 500)/1000 - MINLFTMAR ; TES 8/29/74 ADDED ;
01800 COMMENT HBPI HORIZ BITS PER INCH, MINLFTMAR BIT MIN MARGIN;
01900 IF NOT MICRO AND (PAGEHIGH > IML OR PAGEWIDE > IMC) THEN
02000 BEGIN "EXPAND"
02100 IFC SAILVER THENC
02200 IF DEVICE=MIC THEN
02300 BEGIN "FRAME SIZE"
02400 IF LASL NEQ 1000 THEN OUT(LISTCHAN, ENDPAGE) ;
02500 NVERTI ← 11000 DIV PAGEHIGH MIN 16384 DIV PAGEWIDE MIN 375 ;
02600 NHORIZ ← 10*NVERTI DIV 11 ; NCSIZE ← (9*NHORIZ DIV 80)*8 ;
02700 OUT(LISTCHAN, SETSIZE(NCSIZE)&SETHORIZ(NHORIZ)&SETVERTI(NVERTI)) ;
02800 END "FRAME SIZE"
02900 ELSE IF DEVICE = LPT THEN
03000 BEGIN
03100 IF (LASL-1) MOD 66 + 1 LEQ 6 AND (PAGEHIGH-1) MOD 66 < 60 THEN
03200 OUT(LISTCHAN, ENDPAGE) ;
03300 ENDLINE ← IF PAGEHIGH GEQ 54 THEN RUBOUT & '21 ELSE LF ;
03400 END ;
03500 ENDC;
03600 IML ← PAGEHIGH ; IMC ← PAGEWIDE ;
03700 DONE ; comment, Exit "SIZE" block and immediately reenter with bigger IMG array ;
03800 END "EXPAND" ;
03900
04000 CONTINUE: OUTSTR(SP & CVS(PAGECT ← PAGECT + 1)) ; AVAIL ← IML ;
04100 TOPMAR ← BOTMAR ← VBPI ; COMMENT *** TEMP VALUE -- 1" ;
04200 RASTPHIGH ← 11*VBPI - (TOPMAR+BOTMAR) ; COMMENT *** TEMP *** ;
04300 RASTPWIDE ← (17*HBPI)/2 - (LFTMAR+RGTMAR) ; COMMENT *** TEMP *** ;
04400 RASTLHIGH ← RASTPHIGH/PAGEHIGH ;
04500 IFC SAILVER THENC
04600 IF PAGECT > 1 THEN
04700 IF DEVICE = LPT THEN COMMENT AVOID SPURIOUS BLANK PAGE ;
04800 IF (IML-1) MOD 66 < 60 THEN OUT(LISTCHAN, ENDPAGE)
04900 ELSE FOR L ← (LASL-1) MOD 66 + 2 THRU 66 DO
05000 BEGIN OUT(LISTCHAN, CR) ; OUT(LISTCHAN, ENDLINE) END
05100 ELSE OUT(LISTCHAN, ENDPAGE) ;
05200 ENDC
05300 IFC CMUXGP THENC
05400 IF PAGECT>1 THEN OUT(LISTCHAN,ENDPAGE);
05500 ENDC
05600
05700 IFC PARCVER THENC
05800 IF MICRO THEN
05900 BEGIN
06000 FSTFONT ← -1 ;
06100 DLBP ← DLBP1 ;
06200 TLIX ← 0 ;
06300 END ;
06400 ENDC
00100 WHILE (TOPLINE ← INNUM) > -10 DO
00200 BEGIN "AREA"
00300 NCOLS ← INNUM ; NLINES ← INNUM ;
00400 FOR COL ← 1 THRU NCOLS DO
00500 BEGIN "COLUMN"
00600 LEFTCH ← INNUM ;
00700 TLFTMAR ← LFTMAR + CHARW*(LEFTCH-1) ; TVR: Initiallize left margin for this column ;
00800 WHILE (LINENO ← INNUM) DO
00900 BEGIN "LINE"
01000 SH ← SHORTM ← INNUM ;
01005 MLEAD ← INNUM ; TES 11/2/74 ;
01010 SG ← FSTBRK ← -1 ;
01015 BRKS ← CHRS ← FSTCHRS ← SLIDETOP ← 0 ;
01100 LINE ← TOPLINE - 1 + LINENO ;
01200 IF LINE<1 OR LINE>PAGEHIGH THEN
01210 BEGIN
01220 WARN("Area outside page. If Pass one didn't tell you too, then there is a bug in PUB");
01230 LINE←LINE MAX 1 MIN PAGEHIGH ;
01240 END ;
01300 L ← INNUM ; F ← L MOD FIML ; OWL ← OWLS[F] ;
01400 IF FULSTR(OWL) THEN BEGIN FROMFILE ← FALSE ; OWLS[F] ← NULL END
01500 ELSE BEGIN FROMFILE ← TRUE ;
01600 WHILE L NEQ (M←CVD(INPUT(SCHAN, TO!ALTMODE!SKIP))) DO
01700 BEGIN S ← NULL ;
01800 RKJ: 4-26-74, added EOF stuff on next two lines ;
01900 DO S ← S & INPUT(SCHAN, TO!LF!APPD) UNTIL PAGEBRC = LF OR PAGEEOF ;
02000 IF PAGEEOF THEN USERERR(0,0,"Bad input from Pass One (a PUB bug), I give up.");
02100 OWLS[M MOD FIML] ← S ;
02200 END ;
02300 END ;
02400 IF NOT DEBUG THEN S ← SCN(TO!ALTMODE!SKIP)
02500 ELSE BEGIN
02600 SR ← IF MICRO THEN NULL ELSE SRCREF[LINE] ;
02700 SR ← SR & " " & SCN(TO!RUB!ALT!SKIP) ;
02800 WHILE PAGEBRC NEQ ALTMODE DO
02900 BEGIN "ERROR MESSG"
03000 S ← SCN(TO!RUB!ALT!SKIP) ; M ← LENGTH(S)+3 ; L ← LINE ;
03100 IF DEVICE=TTY OR (IMC MAX 75)+13*(NCOLS-COL)+LENGTH(SR)+M LEQ 119 THEN
03200 SR ← SR & "..." & S ;
03300 END "ERROR MESSG" ;
03400 IF NOT MICRO THEN SRCREF[LINE] ← SR ;
03500 END ;
03600 DO BEGIN "PIECE"
03700 S ← SCN(BREAKER) ; TES 11/6/74 ;
03800 WHILE NOT PAGEEOF AND NOT PAGEBRC DO
03850 S ← S & SCN(BREAKER) ; TES 11/6/74 ;
03900 CHRS ← CHRS + LENGTH(SEG[STEP!SG] ← S) ;
00100 CASE CHARTBL[PAGEBRC] OF
00200 BEGIN comment by BRC ;
00300
00400 comment 0 ... ; IMPOSSIBLE("0"&CVOS(PAGEBRC)&" Break Character") ;
00500
00600 comment 1 ... RUBOUT -- Font change ; BEGIN
00700 SEG[STEP!SG] ← RUBOUT & (F←SCN(ONE!CHAR)) &
00800 (S ← IF F="-" OR F="+" OR F="=" THEN SCN(TO!ALTMODE!SKIP)
00900 ELSE IF F = "F" THEN SCN(ONE!CHAR)
01000 ELSE IF F="π" THEN SCNBYCOUNT(SCN(ONE!CHAR))
01100 ELSE NULL) ;
01200 IF F = "π" THEN CHRS ← CHRS + 1
01300 ELSE IF F = "+" THEN CHRS ← CHRS + CVD(S)
01400 ELSE IF F = "-" THEN CHRS ← CHRS - CVD(S)
01500 ELSE IF F = "→" THEN
01600 BEGIN COMMENT ∞ ;
01700 IF (SLIDETOP ← SLIDETOP + 1) > 5 THEN SLIDERROR ;
01800 SLIDESG[SLIDETOP] ← SG ; RB[SLIDETOP] ← SCNUM ;
01900 LBD[SLIDETOP] ← SCNUM ;
02000 IF RASTER THEN
02100 BEGIN
02200 RKJ; XFILL[SLIDETOP] ← SCNUM ;
02300 TES ; XINF[SLIDETOP] ← SCNUM ;
02400 END ;
02500 LBF[SLIDETOP] ← SCN(TO!ALTMODE!SKIP) ;
02600 IF RASTER AND FULSTR(LBF[SLIDETOP]) THEN STEP!SG ; RKJ: 1-9-74;
02700 FLUSHING ← TRUE;
02800 END
02900 ELSE IF F = "←" THEN
03000 RIGHTBOUND
03100 ELSE IF F = "=" THEN BEGIN
03200 comment 8/9/73 RKJ IF RASTER THEN SHORTM←(SHORTM-BRKS*CHARW) MAX 0;
03300 BRKS←0 ; FSTCHRS←CHRS←CVD(S) ; FSTBRK←SG END ;
03400 END ; COMMENT NOJUST LEFT OF TAB ;
03500
03600 comment 2 ... ALTMODE -- Word Break ; BEGIN BRKS ← BRKS + 1 ; SEG[STEP!SG] ← ALTMODE END ;
03700
03800 comment 3 ... VT -- label reference ;
03900 BEGIN "LABEL REF"
04000 STRING S;
04100 S ← LABTAB[(F←SCNUM) LSH -14, F LAND '37777] ;
04200 L ← LENGTH(SEG[STEP!SG] ← SCAN(S, TO!ALTMODE!SKIP, DUMMY)) ;
04300 J ← CVD(S) ;
04400 SHORTM ← SHORTM - (IF RASTER THEN J ELSE L) ; CHRS ← CHRS + L ;
04500 IF FLUSHING AND RASTER THEN FSIZE←FSIZE+J ;
04600 END "LABEL REF" ;
00100 comment 4 ... CR -- Justify it ;
00200 BEGIN "JUSTIFY"
00300 WHILE SLIDETOP DO BEGIN SLIDERROR ; RIGHTBOUND END ;
00400 IF SHORTM < 0 THEN SHORTM ← 0 ;
00500 IFC SAILVER THENC IF DEVICE = MIC THEN SHORTM ← SHORTM*NHORIZ ELSE ENDC
00600 BEGIN "DISTRIBUTE SPACES"
00700 COMMENT beta(α,K) = [α(K+1)] - [αK], PJ 5/27/74 ITS doesn't like <control-C>'s
00800 WHERE α = SHORTM/BRKS, is h.m. spaces to insert at the K'th break ;
00900 RATIO ← IF BRKS=0 THEN 0.0 ELSE SHORTM/BRKS ; TERM ← RATIO + .0001 ; BRKS ← 1 ;
01000 END "DISTRIBUTE SPACES" ;
01100 UNDERLINE←-1 ; LINE←TOPLINE-1+LINENO MAX 1 MIN PAGEHIGH ; CHAR ← 0 MAX LEFTCH-1 MAX 0 ;
01150 IFC CMUVER THENC IF XCRIBL THEN CHAR←LASC[LINE]; ENDC RKJ: 7-Nov-74, needed for multi column;
01200 NOTFST ← FALSE ; CHRS ← CHRS + CHAR ;
01300
01400 TVR: Initial column select for XGP ;
01500 IF XCRIBL AND (LEFTCH NEQ 1 OR LFTMAR > 0) THEN XGPTAB(0) ;
01600 IFC PARCVER THENC IF MICRO THEN OPENLINE(0, -1) ; ENDC
01610
01620 IF XCRIBL THEN LEADING[LINE] ← TES 11/4/74; RKJ: 7-Nov-74;
01630 IF MLEAD = 0 THEN 0
01640 ELSE IF MLEAD > 0 THEN (MLEAD*VBPI + 500)/1000
01650 ELSE -((-MLEAD*VBPI + 500)/1000) ;
01700
01800 IFC SAILVER THENC
01900 IF DEVICE = MIC AND FSTBRK = -1 THEN CHANGESPACING ;
02000 ENDC
02100 FOR G ← 0 THRU SG DO IF FULSTR(S ← SEG[G]) THEN CASE CHARTBL[S] OF
02200 BEGIN comment three cases ;
02300
02400 comment 0 ... text ;
02500 BEGIN "TEXT SEG"
02600 IF UNDERLINE<0 OR BAR=0 TES 10/22/73 ; THEN CHAR ← 0 MAX APPD(S) ELSE
02700 COMMENT *** UNDERLINING *** ;
02800 IF DEVICE = MIC THEN
02900 IFC SAILVER THENC
03000 BEGIN K ← LENGTH(S) ;
03100 WHILE K DO
03200 BEGIN COMMENT DON'T UNDERLINE BLANKS ;
03300 N ← LOP(S) ;
03400 IF N=SP THEN BEGIN UNDERSCORE(CHAR-K) ; UNDERLINE←UNDERLINE+1 END ;
03500 K ← K - 1 ;
03600 END ;
03700 END
03800 ENDC
03900 IFC PARCVER THENC PARCBAR ENDC
04000 ELSE IF XCRIBL THEN
04100 BEGIN
04200 IFC CMUXGP THENC
04300 K←LENGTH(S); SS←0&SPS(K*4); N←LOP(SS);
04400 START!CODE "XGPUNDER"
04500 DEFINE LEN= [2],SRC= [3],DEST= [4],RUB= [5],ESC= [6],R= [7],CNT= ['10],UBAR= ['11];
04600 LABEL LOOP,ELOOP,SPACE,OUTT;
04700 SETZ CNT,0; MOVE LEN,K; MOVE SRC,S; MOVE DEST,SS; MOVEI RUB,'177; MOVEI ESC,'35; MOVE UBAR,BAR;
04800 LOOP: ILDB R,SRC;
04900 CAIE R,BAR; CAIN R,SP; JRST SPACE;
05000 IDPB RUB,DEST; IDPB ESC,DEST; IDPB R,DEST; IDPB UBAR,DEST;
05100 ELOOP: SOJG LEN,LOOP;
05200 MOVEM CNT,N; JRST OUTT;
05300 SPACE: IDPB R,DEST;
05400 AOJA CNT,ELOOP;
05500 OUTT:
05600 END "XGPUNDER";
05700 CHAR ← 0 MAX APPD(SS[1 TO (K*4-N*3)])-(K-N)*3;
05800 LASC[L]←CHAR; FAKE[L]←FAKE[L]+(K-N)*3;
05900 ENDC
06000 IFC SAILXGP THENC CHAR ← 0 MAX APPD(S); ENDC
06100 IFC PARCVER THENC
06200 K←LENGTH(S); SS←0&SPS(K*3); N←LOP(SS);
06300 START!CODE "XGPUNDER"
06400 DEFINE LEN= [2],SRC= [3],DEST= [4],BS= [5],UBAR= [6],CNT= [7],R= ['10];
06500 LABEL LOOP, OUTT, NOBAR; TES 8/19/74 TES CHAR BS BAR -> BAR BS CHAR, FOR BOBROW ;
06600 SETZ CNT,0;
06700 MOVE LEN,K; MOVE SRC,S; MOVE DEST,SS; MOVEI BS,'10; MOVE UBAR,BAR;
06800 LOOP: SOJL LEN,OUTT;
06900 ILDB R,SRC;
07000 CAIE R,BAR; CAIN R,SP; AOJA CNT,NOBAR;
07100 IDPB UBAR,DEST; IDPB BS,DEST;
07200 NOBAR: IDPB R,DEST;
07300 JUMPA LOOP;
07400 OUTT: MOVEM CNT,N;
07500 END "XGPUNDER";
07600 CHAR ← 0 MAX APPD(SS[1 TO (K*3-N*2)])-(K-N)*2;
07700 LASC[L]←CHAR; FAKE[L]←FAKE[L]+(K-N)*2;
07800 ENDC
07900 END
00100 ELSE BEGIN CHAR ← 0 MAX APPD(S);
00200 K ← LENGTH(S) ; SS ← 0&S ; N ← LOP(SS) ; CHAR ← 0 MAX CHAR-K ;
00300 IFC NOT CMUXGP THENC RKJ: 1-7-74;
00400 START!CODE "UNDER" LABEL LOOP ;
00500 MOVE 2, K ; MOVE 3, SS ;
00600 LOOP: ILDB 4,3 ; CAIE 4,SP ; CAIN 4,BAR ; CAIA 0,0 ; MOVE 4,BAR ; DPB 4,3 ; SOJG 2,LOOP ;
00700 END "UNDER" ; CHAR ← 0 MAX APPD(SS[1 TO LENGTH(S)]) ;
00800 ELSEC CHAR ← 0 MAX APPD(S); ENDC RKJ: 1-7-74;
00900 END ;
01000 END "TEXT SEG" ;
01100
01200 comment 1 ... RUBOUT -- Font Change ;
01300 IF (F←S[2 FOR 1])="↑" THEN
01400 IFC SAILVER THENC IF DEVICE=MIC THEN CTRL(DOUDOTS(CCSIZE MIN 63)) ELSE ENDC
01500 IFC PARCVER THENC
01600 IF MICRO THEN PARCSUPER ELSE
01700 IF XCRIBL THEN
01800 IF (SCRLVL←SCRLVL+SCRIPT) LEQ 0 THEN CTRL("R"-'100) ELSE
01900 BEGIN LABEL L1;
02000 CTRL("U"-'100);
02100 L1:
02200 IF G<SG THEN
02300 BEGIN
02400 SS←SEG[G+1];
02500 IF NULSTR(SS) THEN BEGIN G←G+1; GO L1 END; comment try again ;
02600 IF EQU(SS[1 FOR 2],RUBOUT&"F") THEN
02700 BEGIN
02800 G←G+1;
02900 CTRL(SS[3 FOR 1]);
03000 END ELSE CTRL(THISFONT+"0");
03100 END ELSE CTRL(THISFONT+"0")
03200 END
03300 ELSE ENDC
03400 IFC SAILXGP THENC
03500 IF XCRIBL THEN
03600 CTRL(ESCAPE1&'43&(SCRLVL←SCRLVL+SCRIPT))
03700 ELSE ENDC LINE←LINE-1 MAX 1
03800 ELSE IF F = "↓" THEN
03900 IFC SAILVER THENC IF DEVICE=MIC THEN CTRL(DOUDOTS(-(CCSIZE MIN 63))) ELSE ENDC
04000 IFC PARCVER THENC
04100 IF MICRO THEN PARCSUB ELSE
04200 IF XCRIBL THEN
04300 IF (SCRLVL←SCRLVL-SCRIPT) GEQ 0 THEN CTRL("R"-'100) ELSE
04400 BEGIN LABEL L2;
04500 CTRL("S"-'100);
04600 L2:
04700 IF G<SG THEN
04800 BEGIN
04900 SS←SEG[G+1];
05000 IF NULSTR(SS) THEN BEGIN G←G+1; GO L2 END; comment ↑↑↑ ;
05100 IF EQU(SS[1 FOR 2],RUBOUT&"F") THEN
05200 BEGIN
05300 G←G+1;
05400 CTRL(SS[3 FOR 1]);
05500 END ELSE CTRL(THISFONT+"0");
05600 END ELSE CTRL(THISFONT+"0")
05700 END
05800 ELSE ENDC
05900 IFC SAILXGP THENC
06000 IF XCRIBL THEN
06100 CTRL(ESCAPE1&'43&(SCRLVL←SCRLVL-SCRIPT)) ELSE ENDC LINE←LINE+1 MIN IML
06200 ELSE IF F = "_" THEN
06300 BEGIN
06400 UNDERLINE ← CHAR;
06500 IFC SAILVER THENC
06600 IF XCRIBL THEN CTRL(ESCAPE1&'46);
06700 ENDC
06800 IFC ITSVER PJ 8/23/74 ; THENC
06900 IF XCRIBL THEN BEGIN CTRL(ESCAPE1&'46); CTRL(ESCAPE1&'46) END;
07000 ENDC
07100 END
07200 ELSE IF F = "≡" THEN
07300 BEGIN "END UNDERLINED TEXT"
07400 IFC SAILVER THENC
07500 IF DEVICE = MIC AND BAR TES 10/22/73; THEN UNDERSCORE(CHAR) ;
07600 ENDC
07700 UNDERLINE ← -1 ;
07800 IFC SAILVER THENC
07900 IF XCRIBL AND BAR TES 10/22/73; THEN
08000 CTRL(ESCAPE1&'47&3); TES AND REG 11/19/73 ;
08100 ENDC
08200 IFC ITSVER THENC PJ 8/23/74 ;
08300 IF XCRIBL AND BAR THEN BEGIN CTRL(ESCAPE1&'47&3); CTRL(ESCAPE1&'47&4) END;
08400 ENDC
08500 END "END UNDERLINED TEXT"
08600 ELSE IF F="-" THEN
08700 BEGIN
08800 F ← CVD(S[3 TO ∞]) ;
08900 IF DEVICE=MIC THEN
09000 IFC SAILVER THENC
09100 CTRL(DOLSPCS(F))
09200 ENDC
09300 IFC PARCVER THENC
09400 PARCLEFT
09500 ENDC
09600 ELSE CHAR←CHAR-F MAX 0
09700 END
09800 ELSE IF F="*" THEN CHAR ← 0 MAX LASC[LINE] comment not always correct! ;
09900 ELSE IF F="+" THEN
10000 BEGIN F ← CVD(S[3 TO ∞]) ;
10100 IFC SAILVER THENC
10200 IF DEVICE=MIC THEN CTRL(DORSPCS(F)) ELSE
10300 ENDC
10400 IFC PARCVER THENC
10500 PARCRIGHT
10600 ENDC
10700 IF XCRIBL THEN CTRL(VARBLANK(F))
10800 ELSE CHAR←CHAR+F MIN IMC
10900 END
11000 ELSE IF F="=" THEN
11100 BEGIN "TAB"
11200 F ← CVD(S[3 TO ∞]) ;
11300 IF NOT RASTER THEN F ← (F MAX 0) + LEFTCH - 1 MIN IMC ; TES 8/17/74 FIX BUG ;
11400 IF XCRIBL THEN XGPTAB(F)
11500 ELSE IF DEVICE NEQ MIC THEN CHAR ← F
11600 IFC SAILVER THENC
11700 ELSE IF F < CHAR THEN DOLSPCS(CHAR - F)
11800 ELSE IF F > CHAR THEN DORSPCS(F - CHAR) ;
11900 ENDC
12000 IFC PARCVER THENC PARCTAB ENDC
12100 END "TAB"
12200 ELSE IF F = "π" THEN
12300 BEGIN TES 11/29/73 REWROTE ; TES 11/4/74 ADDED SPECIAL ;
12400 BOOLEAN SPECIAL ;
12500 IFC CMUXGP THENC
12600 IF UNDERLINE GEQ 0 AND BAR THEN CTRL(RUBOUT&'35) ;
12700 ENDC TES 12/13/73 ;
12800 SPECIAL ← S[3 FOR 1] = 63 ;
12900 SS ← UNMASH(S[(IF SPECIAL THEN 4 ELSE 3) TO ∞]) ;
13000 IFC PARCVER THENC
13100 IF XCRIBL THEN SS←CTLQ&SS ;
13200 IF MICRO THEN PARCPICHAR
13300 ELSE
13400 ENDC
13500 BEGIN
13600 F ← LENGTH(SS)-1 ; CHAR ← 0 MAX APPD(SS)-F ;
13700 LASC[L] ← CHAR ; FAKE[L] ← FAKE[L] + F ;
13800 IF UNDERLINE GEQ 0 AND BAR AND DEVICE NEQ MIC
13900 IFC SAILXGP THENC AND NOT XCRIBL ENDC
14000 THEN CTRL(IFC PARCVER THENC '10& ENDC BAR) ; TES 12/13/73;
14100 END ;
14200 END
14300 ELSE IF F = "←" THEN BEGIN END
00100 ELSE IF F="F" THEN FONTSELECT(S[3 FOR 1])
00200 ELSE IF F='35 THEN COMMENT OVERSTRIKE NEXT CHAR OVER LAST ;
00300 BEGIN "OVERSTRIKE"
00400 IFC CMUXGP THENC
00500 INTEGER Q;
00600 Q←IMG[L][(LASC[L]+FAKE[L]) FOR 1];
00700 LASC[L]←LASC[L]-1; CHAR ← 0 MAX CHAR-1;
00800 CTRL(RUBOUT&'35); CHAR ← 0 MAX APPD(Q);
00900 ENDC
01000 IFC SAILXGP THENC WARN("Overstrike unimplemented") ENDC
01100 IFC PARCVER THENC
01200 PARCOVLY
01300 ENDC
01400 END
01500 ELSE IF F=RUBOUT THEN IF NOT XCRIBL THEN CHAR←APPD(SP) ELSE
01600 BEGIN
01700 CHAR ← 0 MAX APPD(RUBOUT&RUBOUT)-1; LASC[L]←CHAR; FAKE[L]←FAKE[L]+1;
01800 END
01900 ELSE IMPOSSIBLE("0"&CVOS(F)&" Control Character") ;
02000
02100 comment 2 ... ALTMODE -- word break ;
02200 IF SHORTM AND G > FSTBRK THEN
02300 IFC SAILVER THENC IF DEVICE = MIC THEN CHANGESPACING ELSE ENDC
02400 BEGIN "SPREAD"
02500 TERMX ← RATIO*(BRKS←BRKS+1) + .0001 ;
02600 IF RASTER THEN
02700 BEGIN "DOVSB"
02800 F ← ((TERMX-TERM) MIN SHORTM) ;
02900 IFC PARCVER THENC IF MICRO THEN PARCJUST ELSE ENDC
03000 CTRL(VARBLANK(F)) ;
03100 SHORTM← SHORTM-F
03200 END "DOVSB"
03300 ELSE CHAR ← 0 MAX CHAR + TERMX - TERM MIN IMC ;
03400 TERM ← TERMX ;
03500 END "SPREAD"
03600 ELSE IF RASTER THEN
03700 BEGIN
03800 CHAR ← 0 MAX APPD(SP);
03900 END;
04000
04100 comment 3-5 ; IMPOSSIBLE("VT in SEG[]") ; IMPOSSIBLE("CR in SEG[]") ; IMPOSSIBLE("LF in SEG[]") ;
04200 END ; COMMENT three cases ;
04300 IFC SAILVER THENC IF CHORIZ NEQ NHORIZ THEN CTRL(SETHORIZ(NHORIZ)) ; ENDC
04400 IFC SAILXGP THENC
04500 IF XCRIBL AND UNDERLINE GEQ 0 THEN
04600 CTRL(ESCAPE1&'47&BASELINE);
04700 ENDC
04800 BRKS ← CHRS ← FSTCHRS ← SLIDETOP ← 0 ; SG ← FSTBRK ← -1 ; SHORTM ← SH ;
04900 IFC PARCVER THENC PARCLOSE ENDC
05000 END "JUSTIFY" ;
00100 comment 5 ... LF ; BEGIN END ;
00200 END ; comment, by BRC ;
00300 END "PIECE"
00400 UNTIL PAGEBRC = LF ;
00500 END "LINE" ;
00600 END "COLUMN" ;
00700 END "AREA" ;
00800
00900 IFC PARCVER THENC PARCPAGE ENDC
01000
01100 BEGIN "FINPAGE"
01200 FOR LASL ← PAGEHIGH DOWN 1 DO IF LASC[LASL] THEN DONE ;
01300
01400 F ← 120 - (IMC MAX 78) ;
01500
01600 FOR N ← 1 THRU LASL DO
01700 BEGIN "LIST LINE"
01800
01900 L ← N ;
02000 IF DEBUG AND LENGTH(S←SRCREF[L])>F AND DEVICE=LPT THEN
02100 S←S[1 TO F] ;
02200 NEEDCR ← FALSE ;
02300
02400 DO BEGIN "PART LINE"
02500 IF CHAR ← LASC[L] THEN
02600 BEGIN "NONBLANK"
02700 IF NEEDCR THEN OUT(LISTCHAN, RESTARTLINE)
02800 ELSE NEEDCR ← TRUE ; TES 11/1/73;
02900 OUT(LISTCHAN, FIXUP(IMG[L][1 TO CHAR+FAKE[L]])) ;
03000 IFC CMUVER THENC RKJ: 26-SEP-74 - KLUDGE;
03100 IF XCRIBL AND FIRST!OUTPUT THEN
03200 BEGIN
03300 FIRST!OUTPUT←FALSE;
03400 DUMMY←CHNCDB(LISTCHAN);
03500 START!CODE
03600 MOVE 1,DUMMY; HLRZ 1,2(1); MOVE 2,1(1);
03700 MOVEI 3,1; MOVEM 3,1(2);
03800 END;
03900 END;
04000 ENDC
04100 IF DEBUG AND L=N AND FULSTR(S) THEN OUT(LISTCHAN,
04200 (IF XCRIBL THEN XTABSTR(LFTMAR+IMC*CHARW+1)
04300 ELSE SPS((IMC MAX 80)-CHAR)) RKJ: 1-4-74;
04400 & S);
04500 END "NONBLANK" ;
04600 CHAR ← 0 MAX L ; L ← LINK[CHAR] ;
04700 LINK[CHAR] ← LASC[CHAR] ← FAKE[CHAR] ← 0 ;
04800 END "PART LINE" UNTIL L=0 ;
04900 OUT(LISTCHAN, CR) ; COMMENT ALWAYS CR BEFORE LF ;
05000
05100 IF NEEDVERTI AND
05150 ((L ← LEADING[N+1]+RASTVERTI) IFC SAILXGP THENC NEQ ELSEC > ENDC INTRA) THEN
05200 IFC PARCVER THENC
05300 BEGIN
05400 OUT(LISTCHAN, ENDLINE) ;
05500 OUT(LISTCHAN, CTLK&CVS(L-INTRA)&".") ;
05600 END
05650 ENDC
05700 IFC CMUXGP THENC OUT(LISTCHAN, ENDLINE) ENDC COMMENT *** ;
05800 IFC SAILXGP THENC OUT(LISTCHAN, ESCAPE1&'42&L) ENDC COMMENT *** ;
05900 ELSE
06000 OUT(LISTCHAN, ENDLINE) ;
06100
06200 LEADING[N] ← 0 ; TES 11/4/74 ;
06300
06400 IF DEBUG THEN SRCREF[N] ← NULL ;
06500 END "LIST LINE" ;
06600
06700 FOR N ← LASL+1 THRU PAGEHIGH DO FAKE[N]←LINK[N]←0 ; TES 4/4/74 ;
06800
06900 IFC ITSVER THENC OUT(LISTCHAN, ENDPAGE) ; ENDC
07000
07100 IFC PARCVER THENC
07200 OUT(LISTCHAN, ENDPAGE) ;
07300 ENDC
07400
07500 END "FINPAGE" ;
07600
07700 END "PAGE" ;
07800
07900 IF NOT (PAGEEOF OR PAGEHIGH LEQ 0) THEN DONE ; comment expand IMG ;
08000 RELEASE(ICHAN) ; RELEASE(SCHAN) ;
08100 END "FILE" ;
08200
08300 END "SIZE" UNTIL SEQEOF ;
00100 IFC PARCVER THENC PARCDOC ENDC
00200
00300 IFC SAILVER THENC OUT(LISTCHAN, ENDPAGE) ; ENDC
00400
00500 RELEASE(LISTCHAN) ; RELEASE(SEQCHAN) ;
00600 END "INNER BLOCK" ;
00100 BEGIN EXTERNAL SIMPLE PROCEDURE K!OUT ; K!OUT END ; COMMENT ** ** ** ** ** ;
00200
00300 OUTSTR("." & CRLF) ; comment signal terminal that pass two is done ;
00400 IF DELINT="A" OR DELINT="a" THEN
00500 BEGIN
00600 OUTSTR(CRLF & "DELETE INTERMEDIATE FILES?(Y OR N,CR)") ;
00700 DELINT ← INCHWL ;
00800 END ;
00900 IF DELINT="Y" OR DELINT="y" THEN
01000 BEGIN "DELETE INTERMEDIATE FILES"
01100 IFC TENEX THENC
01200 SIMPLE PROCEDURE DELVER(STRING FINAME) ;
01300 BEGIN INTEGER CHN ;
01400 CHN ← OPENFILE(FINAME&";*", "RO*") ;
01500 DO DELF(CHN) UNTIL NOT INDEXFILE(CHN) ;
01600 RELEASE(CHN) ;
01700 END ;
01800 DELVER(JOBNO & ".PASS2") ;
01900 ENDC
02000 SEQCHAN ← READIN(
02100 IFC TENEX THENC IFILENAME&".FILES" ELSEC "PUPSEQ"&PUIEXT ENDC,
02200 FALSE, SEQBRC, SEQEOF) ;
02300 DO INPUT(SEQCHAN, TO!LF!APPD) UNTIL SEQBRC=LF;
02400 IFC TENEX THENC DELVER(IFILENAME & ".LABELS") ; ELSEC
02500 LABCHAN ← READIN("PULABL"&PUIEXT, FALSE, LABBRC, LABEOF) ;
02600 RENAME(LABCHAN, NULL, 0, I) ;
02700 RELEASE(LABCHAN);
02800 ENDC
02900 AWHILE DO
03000 BEGIN
03100 PAGEFILE ← SPARAM ;
03200 IF SEQEOF THEN DONE ;
03300 IFC TENEX THENC
03400 DELVER(IFILENAME & OCTEXT & PAGEFILE) ;
03500 DELVER(IFILENAME & TXTEXT & PAGEFILE) ;
03600 ELSEC
03700 IFILE ← PAGEFILE & PUIEXT ; SFILE ← PAGEFILE & "S"&PUIEXT ;
03800 ICHAN ← READIN(IFILE, TRUE, PAGEBRC, PAGEEOF) ;
03900 SCHAN ← READIN(SFILE, FALSE, PAGEBRC, PAGEEOF) ;
04000 RENAME(ICHAN, NULL, 0, I) ; RENAME(SCHAN, NULL, 0, I) ;
04100 RELEASE(ICHAN); RELEASE(SCHAN);
04200 ENDC
04300 END ;
04400 IFC NOT TENEX THENC RENAME(SEQCHAN, NULL, 0, I) ENDC ;
04500 RELEASE(SEQCHAN) ;
04600 IFC TENEX THENC DELVER(IFILENAME & ".FILES") ; ENDC
04700 END "DELETE INTERMEDIATE FILES"
04800 ELSE IF DELINT NEQ "N" AND DELINT NEQ "n" THEN
04900 OUTSTR(CRLF&DELINT&"? -- INTERMEDIATE FILES WERE NOT DELETED") ;
05000
05100 IFC SAILVER THENC
05200 IF DEVICE = MIC THEN
05300 BEGIN "PASS 3"
05400 INTEGER FCHAN ;
05500 INTEGER SIMPLE PROCEDURE CORELOC(INTEGER ARRAY A) ; START!CODE MOVE 1, A ; END ;
05600 INTEGER ARRAY PASSTHREE[0:4] ;
05700 FCHAN ← WRITEON("$PUB$"&RPGEXT) ;
05800 OUT(FCHAN, LISTFILE&CRLF&TMPFILE&CRLF&"F"&CRLF&FF) ;
05900 RELEASE(FCHAN) ;
06000 PASSTHREE[0] ← CVSIX("DSK") ;
06100 PASSTHREE[1] ← CVFIL("TXTF80[1,3]", PASSTHREE[2], PASSTHREE[4]) ;
06200 PASSTHREE[3] ← 1 ; COMMENT STARTING ADDRESS IS NORMAL + 1 ;
06300 OUTSTR("PRODUCING FR80 FILE" & CRLF) ;
06400 CALL(CORELOC(PASSTHREE), "SWAP") ;
06500 END "PASS 3" ;
06600 IF XCRIBL THEN LODED("XSPOOL "&LISTFILE&CRLF);
06700 ENDC
06800
06900 IFC CMUVER THENC
07000 RKJ: 26-SEP-74 ALL NEW CODE;
07100 IF XCRIBL AND DOPASS3 THEN
07200 BEGIN "PASS 3"
07300 WTMPFILE("PB3",LISTFILE&CR&LF,TRUE);
07400 RUNPROG("DSK:PUB3[A700PU00]",1);
07500 START!CODE CALLI 0,'12 END;
07600 END "PASS 3";
07700 RKJ: NOW CHECK FOR MORE COMMANDS IN THE TMP FILE;
07800 IF RTMPFILE("PUB",S,FALSE,TRUE) THEN
07900 BEGIN "RERUN"
08000 RUNPROG("PUB",1);
08100 START!CODE CALLI 0,'12 END;
08200 END "RERUN";
08300 ENDC
08400
08500 IFC ISIVER THENC
08600 TES 8-OCT-74 APPROXIMATION TO WHAT ISI NEEDS;
08700 IF XCRIBL AND DOPASS3 THEN
08800 BEGIN "PASS 3"
08900 INTEGER J, JOBNO ;
09000 JOBNO ← CVS(GJINF(J, I, J)) ;
09100 J ← OPENFILE(JOBNO & ".PASS3", "WT") ;
09200 OUT(J, LISTFILE & CRLF) ;
09300 RELEASE(J) ;
09400 RUNPRG("<SUBSYS>PUB3.SAV", 1, 0) ;
09500 CALL(0,"EXIT") ;
09600 END "PASS 3" ;
09700 ENDC
09800 IFC TENEX THENC CALL(1,"EXIT") ; CALL(0,"EXIT"); ELSEC
09900 START!CODE IFC NOT ITSVER THENC CALLI 1,'12; ENDC CALLI 0,'12; END;
10000 ENDC
10100
10200 MAKEBE(WCW, CW) ;
10300
10400 END "VARIABLE BOUND ARRAY BLOCK" ;
10500
10600 END "PUB2" ;